home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / ptool.arc / PTOOLSCR.INC < prev    next >
Text File  |  1985-06-06  |  12KB  |  295 lines
  1. { PTOOLSCR.INC   Copyright 1985  R D Ostrander                   Version 1.0
  2.                                  Ostrander Data Services
  3.                                  5437 Honey Manor Dr
  4.                                  Indianapolis  IN  46241
  5.  
  6.  This Turbo Pascal function is a record oriented data entry tool used to
  7.  automate the programming effort involved in setting up operator editting
  8.  screen. It uses PTOOLENT to allow entry of each field; PTOOLENT.INC must be
  9.  included in the calling program before PTOOLSCR.INC.
  10.  
  11.  This program has been placed in the Public Domain by the author and copies
  12.  may be freely made for non-commercial, demonstration, or evaluation purposes.
  13.  Use of these subroutines in a program for sale or for commercial purposes in
  14.  a place of business requires a $20 fee be paid to the author at the address
  15.  above.  Personal non-commercial users may also elect to pay the $20 fee to
  16.  encourage further development of this and similar programs. With payment you
  17.  will be able to receive update notices, diskettes and printed documentation
  18.  of this and other PTOOLs from Ostrander Data Services.
  19.  
  20.  
  21.  PTOOL, and PTOOLxxx are Copyright Trademarks of Ostrander Data Services
  22.  
  23.  Turbo Pascal is a Copyright of Borland International Inc.
  24.  
  25. Usage of this procedure is as follows:
  26.  
  27.   1) Code Record area for operator editting.
  28.  
  29.   2) Include PTOOLENT.INC in your calling program.
  30.  
  31.   3) Include PTOOLSCR.INC in your calling program.
  32.  
  33.   4) Create the Field Table constants necessary for the PTOOLSCR procedure
  34.      call. The PTOOLSCR_Field_Array type is laid out below.
  35.  
  36.           These first 4 steps must be done while writing your program.
  37.           The next 3 steps are program actions during execution.
  38.  
  39.   5) Fill the Record area with the data to be presented to the operator at
  40.      the beginning of the edit.
  41.  
  42.   6) Call PTOOLSCR.
  43.  
  44.   7) Recieve the changed data in the Record area and the Return Code and
  45.      Last Field from PTOOLSCR.
  46.  
  47.  
  48. The screen is first painted with description and display information; then
  49. the fields are presented to the operator in field table order who may edit
  50. fields according to the rules of PTOOLENT and may move between fields by
  51. the following actions:
  52.  
  53.     C/R,  <Ctrl-N>,  <Ctrl-Q>   - Moves to the next field until, after the
  54.     Filled Field, Down Arrow      last field a Return Code of 1 is passed
  55.                                   back to the calling program.
  56.     Home                        - Returns to editting the first field.
  57.     Up Arrow                    - Returns to editting the previous field.
  58.     End                         - Moves to edit the last field.
  59.  
  60. Any other special key such as the Function Keys, PgUp, PgDn, etc will end
  61. the screen editting and pass back the Return Code as per PTOOLENT.
  62.  
  63. The data may be presented to the operator in "Display only" mode by putting
  64. a 'D' in the Display_Only parameter before the call. Control will immediately
  65. be passed back to the calling program.
  66.  
  67. The screen painting may be eliminated on the second and subsequent call with
  68. the same record type by putting a 'N' in the Screen_Paint parameter before
  69. the call. This will make your program appear much "snappier".
  70.  
  71. Watch out that the following items are carefully handled:
  72.  
  73.    > The X/Y coorodinates, Relative record position, Display size parameters
  74.      in the Field Table must have leading zeroes.
  75.  
  76.    > The Relative record position in the Field Table must be accurate, having
  77.      any bad numbers here will cause you monumental headaches during testing
  78.      since you may be displaying character or string data as integers, bytes
  79.      or reals. This is the first place to look if PTOOLSCR doesn't seem to be
  80.      working right.
  81.  
  82.    > Record information must be correct before calling PTOOLSCR. This applies
  83.      to string data. If these fields aren't initialized, strange results may
  84.      happen.
  85.                                                                             }
  86.  
  87. { Type value for inclusion in the calling program's Field Table is here for
  88.   convenience only. String [55] will work just as well.                     }
  89.  
  90.  
  91. TYPE
  92.  
  93.      PTOOLSCR_Field_Array = String [55];
  94.  
  95.               { Char  1    = Field Type   B = Byte    - 1 byte
  96.                                           C = Char    - 1 byte
  97.                                           D = Dummy   - for display text only.
  98.                                                         no data editted
  99.                                           M = Message - for display and
  100.                                                         message text only.
  101.                                                         string data that is
  102.                                                         not editted
  103.                                           I = Integer - 2 bytes
  104.                                           R = Real    - 6 bytes
  105.                                           S = String  - String length
  106.                                                         plus 1 byte
  107.                 Char  2-3  = X position of display text
  108.                 Char  4-5  = Y position of display text
  109.                 Char  6-45 = Up to 40 characters of display text
  110.                 Char 46-48 = 1 relative position of field in record
  111.                 Char 49-50 = X position of field display verbage
  112.                 Char 51-52 = Y position of field display verbage
  113.                 Char 53-54 = Display size of field
  114.                 Char 55    = Number of decimal places for field type R }
  115.  
  116.  
  117. { Called Procedure Begins Here ******************************************** }
  118.  
  119.  
  120. Procedure PTOOLSCR (VAR Record_Area,
  121.                         Table_Area;
  122.                         Num_Fields   : Integer;
  123.                     VAR ReturnCode   : Integer;
  124.                     VAR LastField    : Integer;
  125.                         Display_Only : Char;
  126.                         Paint_Screen : Char;
  127.                         First_Field  : Integer);
  128.  
  129. VAR
  130.  
  131.    I             : Integer;
  132.    RecChar       : Array [1..2] of Char                 absolute Record_Area;
  133.    Table         : Array [1..2] of PTOOLSCR_Field_Array absolute Table_Area;
  134.    TableHold     : PTOOLSCR_Field_Array;
  135.  
  136.    WorkArea      : String [80];
  137.    WByte         : Byte         Absolute WorkArea;
  138.    WInteger      : Integer      Absolute WorkArea;
  139.    WReal         : Real         Absolute WorkArea;
  140.    XorkArea      : String [80];
  141.    XByte         : Byte         Absolute XorkArea;
  142.    XInteger      : Integer      Absolute XorkArea;
  143.    XReal         : Real         Absolute XorkArea;
  144.  
  145.    TypeData      : Char;
  146.    DescX, DescY  : Byte;
  147.    Desc          : String [40];
  148.    Position      : Integer;
  149.    DispX, DispY  : Byte;
  150.    DispSize      : Integer;
  151.    Decimals      : Integer;
  152.  
  153.    EditType      : Char;
  154.    SpaceString   : String [80];
  155.  
  156.  
  157. Procedure Set_Table (I : Integer);
  158. Var
  159.      TableEntry : PTOOLSCR_Field_Array;
  160.      TableChar  : Array [1..55] of Char absolute TableEntry;
  161.      X          : Byte;
  162. Begin
  163.      TableEntry := Table [I];
  164.      TypeData   := TableChar [2];
  165.      DescX      := ((Ord (TableChar [3]) - 48) * 10)
  166.                   + (Ord (TableChar [4]) - 48);
  167.      DescY      := ((Ord (TableChar [5]) - 48) * 10)
  168.                   + (Ord (TableChar [6]) - 48);
  169.      Move (TableChar [7], Desc [1], 40);
  170.      X := 40;
  171.      While (Desc [X] = ' ') and (X > 1) do
  172.            X := X - 1;
  173.      Desc [0]   := Char (X);
  174.      Position   := ((Ord (TableChar [47]) - 48) * 100)
  175.                  + ((Ord (TableChar [48]) - 48) * 10)
  176.                  +  (Ord (TableChar [49]) - 48);
  177.      DispX      := ((Ord (TableChar [50]) - 48) * 10)
  178.                   + (Ord (TableChar [51]) - 48);
  179.      DispY      := ((Ord (TableChar [52]) - 48) * 10)
  180.                   + (Ord (TableChar [53]) - 48);
  181.      DispSize   := ((Ord (TableChar [54]) - 48) * 10)
  182.                   + (Ord (TableChar [55]) - 48);
  183.      Decimals   :=  (Ord (TableChar [56]) - 48);
  184. End;
  185.  
  186.  
  187.  
  188. BEGIN
  189.  
  190. For I := 1 to 80 do
  191.     SpaceString [I] := ' ';
  192. If Paint_Screen <> 'X' then For I := 1 to Num_Fields do
  193.     Begin
  194.          Set_Table (I);
  195.          If (Paint_Screen <> 'N') and (Desc <> ' ') then
  196.             Begin
  197.             Gotoxy (DescX, DescY);
  198.             Write  (Desc);
  199.             End;
  200.          If TypeData <> 'D' then
  201.             Begin
  202.             Move (RecChar [Position], WorkArea [0], 81);
  203.             Gotoxy (DispX, DispY);
  204.             Case TypeData of
  205.              'B' : Write (Wbyte:DispSize);
  206.              'C' : Write (RecChar [Position]);
  207.              'I' : Write (WInteger:DispSize);
  208.              'R' : Write (WReal:DispSize:Decimals);
  209.              'M' : Begin
  210.                    SpaceString [0] := Char (DispSize);
  211.                    Write (SpaceString);
  212.                    Gotoxy (DispX, DispY);
  213.                    Write (WorkArea);
  214.                    End;
  215.              'S' : Write (WorkArea);
  216.              End; {Case}
  217.             End;
  218.     End;
  219. If not (Display_Only in ['D', 'M']) then
  220.    Begin
  221.    I := First_Field;
  222.    While I <= Num_Fields do
  223.          Begin
  224.          Set_Table (I);
  225.          If TypeData in ['D', 'M'] then
  226.             I := I + 1
  227.          else
  228.             Begin
  229.             Move (RecChar [Position], WorkArea [0], 81);
  230.             Gotoxy (DispX, DispY);
  231.             EditType := TypeData;
  232.             Case TypeData of
  233.              'B' : Begin
  234.                    EditType := 'I';
  235.                    XInteger := WByte;
  236.                    End;
  237.              'C' : Begin
  238.                    XorkArea [1] := RecChar [Position];
  239.                    XorkArea [0] := Char (1);
  240.                    EditType     := 'S';
  241.                    End;
  242.              'I' : Xinteger := WInteger;
  243.              'R' : XReal    := WReal;
  244.              'S' : XorkArea := WorkArea;
  245.              End; {Case}
  246.             PTOOLENT (XorkArea,
  247.                       EditType,
  248.                       DispSize,
  249.                       Decimals,
  250.                       ReturnCode);
  251.             LastField := I;
  252.             Case TypeData of
  253.              'B' : Begin
  254.                    WByte := XInteger;
  255.                    Move (WByte, RecChar [Position], 1);
  256.                    End;
  257.              'C' : Move (XorkArea [1], RecChar [Position], 1);
  258.              'I' : Move (XorkArea, RecChar [Position], 2);
  259.              'R' : Move (XorkArea, RecChar [Position], 6);
  260.              'S' : Move (XorkArea, RecChar [Position],
  261.                          Ord (XorkArea [0]) + 1);
  262.              End; {Case}
  263.             Case ReturnCode of
  264.               1, 2, 80 : Begin
  265.                          I := I + 1;
  266.                          ReturnCode := 1;
  267.                          End;
  268.               71       : I := 1;
  269.               72       : Begin
  270.                          I := I - 1;
  271.                          TableHold := Table [I];
  272.                          While (I >= 1) and (TableHold [1] in ['D', 'M']) do
  273.                                Begin
  274.                                I := I - 1;
  275.                                TableHold := Table [I];
  276.                                End;
  277.                          If I <= 0 then I := 1;
  278.                          End;
  279.                79      : Begin
  280.                          I := Num_Fields;
  281.                          TableHold := Table [I];
  282.                          While (I >= 1) and (TableHold [1] in ['D', 'M']) do
  283.                                Begin
  284.                                I := I - 1;
  285.                                TableHold := Table [I];
  286.                                End;
  287.                          If I <= 0 then I := 1;
  288.                          End;
  289.                else      I := Num_Fields + 1;
  290.             End; {Case}
  291.             End;
  292.          End;
  293.    End;
  294.  
  295. END;